/* GUI CONVERTED from pomt.p (converter v1.76) Thu May 30 14:00:47 2002 */
/* pomt.p - PURCHASE ORDER MAINTENANCE - Regular and Blanket POs              */
/* Copyright 1986-2002 QAD Inc., Carpinteria, CA, USA.                        */
/* All rights reserved worldwide.  This is an unpublished work.               */
/* $Revision: 1.13.2.18 $                                                */
/* REVISION: 1.0     LAST MODIFIED: 08/30/86    BY: PML *14*  */
/* REVISION: 1.0     LAST MODIFIED: 02/11/86    BY: EMB       */
/* REVISION: 2.0     LAST MODIFIED: 12/19/86    BY: PML *A3*  */
/* REVISION: 2.0     LAST MODIFIED: 03/12/87    BY: EMB *A41* */
/* REVISION: 4.0     LAST MODIFIED: 03/10/88    BY: FLM *A108**/
/* REVISION: 4.0     LAST MODIFIED: 12/27/87    BY: PML *A119**/
/* REVISION: 4.0     LAST MODIFIED: 01/14/88    BY: WUG *A145**/
/* REVISION: 4.0     LAST MODIFIED: 07/26/88    BY: RL  *C0028*/
/* REVISION: 4.0     LAST MODIFIED: 10/25/88    BY: WUG *A494**/
/* REVISION: 4.0     LAST MODIFIED: 12/13/88    BY: MLB *A560**/
/* REVISION: 4.0     LAST MODIFIED: 02/27/89    BY: WUG *B038**/
/* REVISION: 4.0     LAST MODIFIED: 03/16/89    BY: MLB *A673**/
/* REVISION: 4.0     LAST MODIFIED: 03/24/89    BY: FLM *A685**/
/* REVISION: 4.0     LAST MODIFIED: 04/11/89    BY: FLM *A708**/
/* REVISION: 5.0     LAST MODIFIED: 05/16/89    BY: MLB *B118**/
/* REVISION: 5.0     LAST MODIFIED: 12/21/89    BY: FTB *B466**/
/* REVISION: 5.0     LAST MODIFIED: 02/27/90    BY: EMB *B591**/
/* REVISION: 6.0     LAST MODIFIED: 03/21/90    BY: FTB *D011**/
/* REVISION: 6.0     LAST MODIFIED: 03/22/90    BY: FTB *D013**/
/* REVISION: 6.0     LAST MODIFIED: 05/21/90    BY: WUG *D002**/
/* REVISION: 5.0     LAST MODIFIED: 06/11/90    BY: RAM *B706**/
/* REVISION: 6.0     LAST MODIFIED: 06/20/90    BY: RAM *D030**/
/* REVISION: 6.0     LAST MODIFIED: 06/29/90    BY: WUG *D043**/
/* REVISION: 6.0     LAST MODIFIED: 07/06/90    BY: EMB *D040**/
/* REVISION: 6.0     LAST MODIFIED: 08/13/90    BY: SVG *D058**/
/* REVISION: 6.0     LAST MODIFIED: 10/18/90    BY: PML *D109**/
/* REVISION: 6.0     LAST MODIFIED: 10/24/90    BY: RAM *D135**/
/* REVISION: 6.0     LAST MODIFIED: 10/27/90    BY: pml *D146**/
/* REVISION: 6.0     LAST MODIFIED: 11/13/90    BY: pml *D221**/
/* REVISION: 6.0     LAST MODIFIED: 01/02/91    BY: dld *D259**/
/* REVISION: 6.0     LAST MODIFIED: 01/02/91    BY: MLB *D238**/
/* REVISION: 6.0     LAST MODIFIED: 01/21/91    BY: dld *D311**/
/* REVISION: 6.0     LAST MODIFIED: 02/11/91    BY: RAM *D345**/
/* REVISION: 6.0     LAST MODIFIED: 03/07/91    BY: dld *D409**/
/* REVISION: 6.0     LAST MODIFIED: 03/08/91    BY: RAM *D410**/
/* REVISION: 6.0     LAST MODIFIED: 04/08/91    BY: RAM *D502**/
/* REVISION: 6.0     LAST MODIFIED: 04/11/91    BY: RAM *D518**/
/* REVISION: 6.0     LAST MODIFIED: 05/07/91    BY: RAM *D621**/
/* REVISION: 6.0     LAST MODIFIED: 05/09/91    BY: RAM *D634**/
/* REVISION: 6.0     LAST MODIFIED: 08/15/91    BY: pma *D829**/ /*rev only*/
/* REVISION: 7.0     LAST MODIFIED: 09/12/91    BY: RAM *F033**/
/* REVISION: 6.0     LAST MODIFIED: 09/24/91    BY: RAM *D872**/
/* REVISION: 6.0     LAST MODIFIED: 10/10/91    BY: dgh *D892**/
/* REVISION: 7.0     LAST MODIFIED: 11/08/91    BY: MLV *F029**/
/* REVISION: 6.0     LAST MODIFIED: 11/11/91    BY: RAM *D921**/
/* REVISION: 7.0     LAST MODIFIED: 02/04/92    BY: RAM *F163**/
/* REVISION: 7.0     LAST MODIFIED: 06/19/92    BY: tmd *F458**/
/* REVISION: 7.0     LAST MODIFIED: 07/01/92    BY: afs *F727**/
/* REVISION: 7.0     LAST MODIFIED: 07/31/92    BY: afs *F827*   (rev only)   */
/* REVISION: 7.3     LAST MODIFIED: 08/05/92    BY: tjs *G027**/
/* REVISION: 7.3     LAST MODIFIED: 08/18/92    BY: tjs *G028*   (rev only)   */
/* REVISION: 7.3     LAST MODIFIED: 10/01/92    BY: tjs *G117**/
/* REVISION: 7.3     LAST MODIFIED: 10/08/92    BY: tjs *G143*   (rev only)   */
/* REVISION: 7.3     LAST MODIFIED: 10/12/92    BY: tjs *G164*   (rev only)   */
/* REVISION: 7.3     LAST MODIFIED: 12/18/92    BY: afs *G465*   (rev only)   */
/* REVISION: 7.3     LAST MODIFIED: 01/05/93    BY: mpp *G481*   (rev only)   */
/* REVISION: 7.3     LAST MODIFIED: 01/06/93    BY: bcm *G417**/
/* REVISION: 7.3     LAST MODIFIED: 02/11/93    BY: afs *G674**/
/* REVISION: 7.3     LAST MODIFIED: 02/17/93    BY: tjs *G684*   (rev only)   */
/* REVISION: 7.3     LAST MODIFIED: 02/21/93    BY: afs *G716**/
/* REVISION: 7.3     LAST MODIFIED: 02/22/93    BY: bcm *G717*   (rev only)   */
/* REVISION: 7.3     LAST MODIFIED: 02/23/93    BY: tjs *G728*   (rev only)   */
/* REVISION: 7.3     LAST MODIFIED: 02/23/93    BY: tjs *G735**/
/* REVISION: 7.3     LAST MODIFIED: 03/15/93    BY: tjs *G810**/
/* REVISION: 7.3     LAST MODIFIED: 03/16/93    BY: tjs *G815*   (rev only)   */
/* REVISION: 7.3     LAST MODIFIED: 04/09/93    BY: pma *G928*   (rev only)   */
/* REVISION: 7.3     LAST MODIFIED: 04/19/93    BY: tjs *G964**/
/* REVISION: 7.3     LAST MODIFIED: 04/29/93    BY: afs *G972*   (rev only)   */
/* REVISION: 7.3     LAST MODIFIED: 05/26/93    BY: kgs *GB37*   (rev only)   */
/* REVISION: 7.4     LAST MODIFIED: 06/07/93    BY: jjs *H006*                */
/* REVISION: 7.4     LAST MODIFIED: 07/02/93    BY: dpm *H015*   (rev only)   */
/* REVISION: 7.4     LAST MODIFIED: 07/02/93    BY: dpm *H017*   (rev only)   */
/* REVISION: 7.4     LAST MODIFIED: 07/02/93    BY: dpm *H018*   (rev only)   */
/* REVISION: 7.4     LAST MODIFIED: 07/02/93    BY: jjs *H024*   (rev only)   */
/* REVISION: 7.4     LAST MODIFIED: 07/21/93    BY: dpm *H034*   (rev only)   */
/* REVISION: 7.4     LAST MODIFIED: 07/30/93    BY: cdt *H047*   (rev only)   */
/* REVISION: 7.4     LAST MODIFIED: 08/09/93    BY: bcm *H062*   (rev only)   */
/* REVISION: 7.4     LAST MODIFIED: 08/12/93    BY: tjs *H065*   (rev only)   */
/* REVISION: 7.4     LAST MODIFIED: 09/07/93    BY: tjs *H082**/
/* REVISION: 7.4     LAST MODIFIED: 09/29/93    BY: cdt *H086**/
/* REVISION: 7.4     LAST MODIFIED: 10/28/93    BY: dpm *H198*   (rev only)   */
/* REVISION: 7.4     LAST MODIFIED: 10/23/93    BY: cdt *H184**/
/* REVISION: 7.4     LAST MODIFIED: 11/14/93    BY: afs *H221**/
/* REVISION: 7.4     LAST MODIFIED: 02/10/94    BY: dpm *FM06**/
/* REVISION: 7.4     LAST MODIFIED: 04/19/94    BY: WUG *FN46**/
/* REVISION: 7.4     LAST MODIFIED: 05/23/94    BY: afs *FM85**/
/* REVISION: 7.4     LAST MODIFIED: 05/27/94    BY: afs *FO49**/
/* REVISION: 7.4     LAST MODIFIED: 06/17/94    BY: qzl *H392**/
/* REVISION: 7.4     LAST MODIFIED: 06/21/94    BY: qzl *H397**/
/* REVISION: 7.4     LAST MODIFIED: 09/11/94    BY: rmh *GM16**/
/* REVISION: 7.4     LAST MODIFIED: 09/20/94    BY: ljm *GM74**/
/* REVISION: 7.4     LAST MODIFIED: 10/27/94    BY: cdt *FS95**/
/* REVISION: 7.4     LAST MODIFIED: 11/06/94    BY: rwl *GO27**/
/* REVISION: 8.5     LAST MODIFIED: 11/10/94    BY: mwd *J034**/
/* REVISION: 8.5     LAST MODIFIED: 02/21/95    BY: dpm *J044**/
/* REVISION: 7.4     LAST MODIFIED: 05/03/95    BY: dxk *G0L7**/
/* REVISION: 7.4     LAST MODIFIED: 08/16/95    BY: jym *G0V4**/
/* REVISION: 7.4     LAST MODIFIED: 08/25/95    BY: ais *G0VN**/
/* REVISION: 7.4     LAST MODIFIED: 09/19/95    BY: ais *G0X6**/
/* REVISION: 8.5     LAST MODIFIED: 01/15/95    BY: kxn *J0BS**/
/* REVISION: 8.5     LAST MODIFIED: 09/27/95    BY: taf *J053**/
/* REVISION: 8.5     LAST MODIFIED: 03/19/96    BY: *J0CV* Robert Wachowicz   */
/* REVISION: 8.5     LAST MODIFIED: 04/09/96    BY: *J0HQ* Gary Morales       */
/* REVISION: 8.5     LAST MODIFIED: 05/15/96    BY: *J0LX* Kieu Nguyen        */
/* REVISION: 8.5     LAST MODIFIED: 07/19/96    BY: *J0ZS* T. Farnsworth      */
/* REVISION: 8.5     LAST MODIFIED: 08/16/96    BY: *J146* Sue Poland         */
/* REVISION: 8.6     LAST MODIFIED: 10/22/96    BY: *K004* Kurt De Wit        */
/* REVISION: 8.6     LAST MODIFIED: 12/18/96    BY: *J1CJ* Sue Poland         */
/* REVISION: 8.6     LAST MODIFIED: 01/22/97    BY: *J1B1* Robin McCarthy     */
/* REVISION: 8.6     LAST MODIFIED: 05/16/97    BY: *J1RQ* Suresh Nayak       */
/* REVISION: 8.6E    LAST MODIFIED: 02/23/98    BY: *L007* A. Rahane          */
/* REVISION: 8.6E    LAST MODIFIED: 05/20/98    BY: *K1Q4* Alfred Tan         */
/* REVISION: 8.6E    LAST MODIFIED: 06/02/98    BY: *L020* Charles Yen        */
/* REVISION: 9.1     LAST MODIFIED: 05/28/99    BY: *J3G1* Santosh Rao        */
/* REVISION: 9.1     LAST MODIFIED: 08/02/99    BY: *N014* Robin McCarthy     */
/* REVISION: 9.1     LAST MODIFIED: 03/02/00    BY: *L0SH* Santosh Rao        */
/* REVISION: 9.1     LAST MODIFIED: 03/24/00    BY: *N08T* Annasaheb Rahane   */
/* Revision: 1.13.2.6   BY: Niranjan R.         DATE: 05/24/00  ECO: *N0C7*   */
/* Revision: 1.13.2.7   BY: Mudit Mehta         DATE: 07/06/00  ECO: *N0F3*   */
/* Revision: 1.13.2.8   BY: Pat Pigatti         DATE: 07/14/00  ECO: *N0G2*   */
/* Revision: 1.13.2.9   BY: Ashwini G.          DATE: 07/24/00  ECO: *J3Q2*   */
/* Revision: 1.13.2.10  BY: Anup Pereira        DATE: 07/10/00  ECO: *N059*   */
/* Revision: 1.13.2.11  BY: Ashwini G.          DATE: 08/18/00  ECO: *J3Q4*   */
/* Revision: 1.13.2.12  BY: Ashwini G.          DATE: 09/06/00  ECO: *M0S8*   */
/* Revision: 1.13.2.13  BY: Mudit Mehta         DATE: 09/26/00  ECO: *N0W9*   */
/* Old ECO marker removed, but no ECO header exists *F0PN*                    */
/* Revision: 1.13.2.14      BY: Katie Hilbert  DATE: 04/01/01  ECO: *P002*    */
/* Revision: 1.13.2.15      BY: Jean Miller    DATE: 12/12/01  ECO: *P03N*    */
/* Revision: 1.13.2.16      BY: John Pison     DATE: 03/13/02  ECO: *N1BT*    */
/* Revision: 1.13.2.17      BY: John Pison     DATE: 03/15/02  ECO: *N1D7*    */
/* $Revision: 1.13.2.18 $     BY: Dan Herman     DATE: 05/24/02  ECO: *P018* */
/******************************************************************************/
/* All patch markers and commented out code have been removed from the source */
/* code below. For all future modifications to this file, any code which is   */
/* no longer required should be deleted and no in-line patch markers should   */
/* be added.  The ECO marker should only be included in the Revision History. */
/******************************************************************************/
/* Revision: 9.1      LAST MODIFIED: 28/10/03   BY: *cli* cli   SPEC: HK-S-014*/

/*V8:ConvertMode=Maintenance                                                  */

/* DISPLAY TITLE */
{mfdtitle.i "2+ "}
{cxcustom.i "POMT.P"}
{pxmaint.i}

/* ************************* INPUT-OUTPUT PARAMETERS ************************ */
define input parameter pBlanket as logical no-undo.

/* **************************** SHARED VARIABLES **************************** */
define new shared variable rndmthd  like rnd_rnd_mthd.
define new shared variable oldcurr  like po_curr.
define new shared variable line     like pod_line.
define new shared variable due_date like pod_due_date.
define new shared variable del-yn   like mfc_logical.
define new shared variable qty_ord  like pod_qty_ord.
define new shared variable so_job   like pod_so_job.
define new shared variable sngl_ln  like poc_ln_fmt.
define new shared variable disc     like pod_disc label "Ln Disc".
define new shared variable po_recno as recid.
define new shared variable vd_recno as recid.
define new shared variable yn       like mfc_logical initial yes.
define new shared variable ponbr    like po_nbr.
define new shared variable old_po_stat like po_stat.
define new shared variable line_opened as logical.
define new shared variable old_rev  like po_rev.
define new shared variable pocmmts  like mfc_logical label "Comments".
define new shared variable cmtindx  as integer.
define new shared variable base_amt like pod_pur_cost.
define new shared variable comment_type like po_lang.
define new shared variable new_po   like mfc_logical.
define new shared variable new_db   like si_db.
define new shared variable old_db   like si_db.
define new shared variable new_site like si_site.
define new shared variable old_site like si_site.
define new shared variable continue like mfc_logical no-undo.
define new shared variable tax_in   like ad_tax_in.
define new shared variable tax_recno as recid.
define new shared variable poc_pc_line like mfc_logical initial yes.
define new shared variable impexp      like mfc_logical no-undo.
define new shared variable blanket as logical.
define new shared variable l_include_retain like mfc_logical
   initial yes no-undo.

/* NEW SHARED FRAMES */
define new shared frame a.
define new shared frame b.
define new shared frame vend.
define new shared frame ship_to.

/* ******************************** VARIABLES ******************************* */
define variable zone_to        like txe_zone_to.
define variable zone_from      like txe_zone_from.
define variable old_vend       like po_vend.
define variable old_ship       like po_ship.
define variable impexp_edit    like mfc_logical            no-undo.
define variable upd_okay       like mfc_logical            no-undo.
define variable dummyCharValue as character                no-undo.
define variable old_ers_opt    like po_ers_opt             no-undo.
define variable l_rebook_lines like mfc_logical initial no no-undo.

/*cli*/ define variable nrm-seq-num like so_nbr init "".
/*cli*/ define variable nrmnbr     like nr_seqid. 
/*cli*/ define new shared variable posite     like po_site. 


{pocnvars.i} /* Variables for consignment inventory */
{pocnpo.i}  /* Consignment procedures */

/*============================================================================*/
/* ****************************** Main Block ******************************** */
/*============================================================================*/

/* DETERMINE IF SUPPLIER CONSIGNMENT IS ACTIVE */
{gprun.i ""gpmfc01.p""
   "(input ENABLE_SUPPLIER_CONSIGNMENT,
     input 11,
     input ADG,
     input SUPPLIER_CONSIGN_CTRL_TABLE,
     output using_supplier_consignment)"}
/*GUI*/ if global-beam-me-up then undo, leave.


assign
   blanket = pBlanket
   old_db = global_db.

/* DEFINE ROUND VARIABLES REQUIRED FOR PURCHASE ORDERS & RTS */
{pocurvar.i "NEW"}
/* DEFINE ROUND VARIABLES REQUIRED FOR TAX CALCULATIONS */
{txcurvar.i "NEW"}

/* DEFINE TRAILER VARS AS NEW, SO THAT CORRECT _OLD FORMATS */
/* CAN BE ASSIGNED BASED ON INITIAL DEFINE                  */
{potrldef.i "NEW"}

{pxrun.i &PROC='initialize-variables'}

mainloop:
repeat:
/*GUI*/ if global-beam-me-up then undo, leave.


   find first gl_ctrl no-lock.

   assign
      so_job = ""
      disc = 0
      comment_type = global_type.

   {popomt02.i}  /* Shared frames a and b */

   /* ADDRESS FORMS */
   {mfadform.i "vend" 1 SUPPLIER}
   {mfadform.i "ship_to" 41 SHIP_TO}

   /*GUI: view frame dtitle. */
IF global-tool-bar AND global-tool-bar-handle ne ? THEN
  view global-tool-bar-handle. /*GUI*/

   view frame a.
   view frame vend.
   view frame ship_to.
   view frame b.

/*cli    {pxrun.i &PROC='get-input'} */
/*cli*** Move all the code from procedure get-input here ******/
   prompt-for po_nbr with frame a
   editing:

      /* Allow last PO number refresh */
      if keyfunction(lastkey) = "RECALL" or lastkey = 307
      then
         display ponbr @ po_nbr with frame a.

      /* FIND NEXT/PREVIOUS  RECORD */
      if blanket = false then do:
         /* Do not scroll thru RTS for PO or PO for RTS */
         {mfnp05.i
            po_mstr
            po_nbr
            "po_type <> ""B"" and po_fsm_type = """""
            po_nbr
            "input po_nbr"}
      end.
      else do:
         {mfnp01.i po_mstr po_nbr po_nbr po_type ""B"" po_type}
      end.

      if recno <> ? then do:

         disc = po_disc_pct.

         /* DISPLAY VENDOR ADDRESS */
         {mfaddisp.i po_vend vend}
         /* DISPLAY SHIP TO ADDRESS */
         {mfaddisp.i po_ship ship_to}

         display
            po_nbr
            po_vend
            po_ship
         with frame a.

         display
            po_ord_date
            po_due_date
            po_buyer
            po_bill
            so_job
            po_contract
            po_contact
            po_rmks
            po_pr_list2
            po_pr_list
            disc
            po_site
            po_project
            po_confirm
            po_curr
            po_lang
            po_taxable
            po_taxc
            po_tax_date
            po_fix_pr
            po_cr_terms
            po_crt_int
            po_user_id
            po_req_id
            pocmmts
            po_consignment
         with frame b.

      end.  /* IF RECNO <> ? */

   end. /* PROMPT-FOR...EDITING */

   find po_mstr where po_nbr = input po_nbr no-lock no-error.
   if available po_mstr then do:

      {pxrun.i &PROC='validateRTSOrder' &PROGRAM='popoxr.p'
               &PARAM="(input po_fsm_type)"
               &NOAPPERROR=true &CATCHERROR=true}

      if return-value <> {&SUCCESS-RESULT} then do:
         next-prompt po_nbr with frame a.
         undo, retry.
      end.

      {pxrun.i &PROC='validateEMTOrder' &PROGRAM='popoxr.p'
               &PARAM="(input po_is_btb)"
               &NOAPPERROR=true &CATCHERROR=true}

      if return-value <> {&SUCCESS-RESULT} then do:
         next-prompt po_nbr with frame a.
         undo, retry.
      end.

   end.

   if input po_nbr <> "" then
      ponbr = input po_nbr.

   do transaction on error undo,retry:
/*GUI*/ if global-beam-me-up then undo, leave.

      if input po_nbr = "" then do:

/*cli**  Begin ***** Generate a new Purchase Order Number from NRM *****/ 

         prompt-for po_site with frame c row 8 center overlay THREE-D .
         assign posite = input po_site.

         {gprun.i ""gpsiver.p""
         "(input posite, input ?, output return_int)"}
/*GUI*/  if global-beam-me-up then undo, leave.

         if return_int = 0 then do:
            /* User does not have access to default site # */
            {pxmsg.i &MSGNUM=2711 &ERRORLEVEL=2 &MSGARG1=posite}
            pause.
            undo, retry.
         end.
         find first nrs_mstr where nrs_site = posite and 
              nrs_ponbr <> "" no-lock no-error.
         if available nrs_mstr then do:  
             assign nrmnbr = nrs_ponbr
                    nrm-seq-num = " ".  
               {gprunp.i "xxnrm" "p" "nr_dispense"
               "(input nrmnbr,
               input TODAY,
               output nrm-seq-num)"}
             if nrm-seq-num = "" then
         /* Get next Purchase Order Number with prefix */
                {pxrun.i &PROC='getNextPONumber' &PROGRAM='popoxr.p'
                 &PARAM="(output poNbr)"
                 &NOAPPERROR=true &CATCHERROR=true}
             else 
                 assign ponbr = nrm-seq-num.

/*GUI*/  if global-beam-me-up then undo, leave.
         end.
         else 
             /* GET NEXT PURCHASE ORDER NUMBER WITH PREFIX */
            {pxrun.i &PROC='getNextPONumber' &PROGRAM='popoxr.p'
             &PARAM="(output poNbr)"
             &NOAPPERROR=true &CATCHERROR=true}
                  
/*GUI*/  if global-beam-me-up then undo, leave.

/*cli*** Ending ** Generate a new Purchase Order Number from NRM *****/

/*cli*
         {pxrun.i &PROC='getNextPONumber' &PROGRAM='popoxr.p'
                  &PARAM="(output poNbr)"
                  &NOAPPERROR=true &CATCHERROR=true}
*cli*/     
      end.
   end.
/*GUI*/ if global-beam-me-up then undo, leave.
 /* DO TRANSACTION ON ERROR UNDO.. */

   {gpbrparm.i &browse=dtlu001.p &parm=c-brparm1 &val=poNbr}

/*cli*** Move all the code from procedure get-input here ******/

   if keyfunction(lastkey) = "end-error" then
      undo mainloop, leave mainloop.

   do transaction on error undo, retry:
/*GUI*/ if global-beam-me-up then undo, leave.


      find first poc_ctrl no-lock.
      if not available poc_ctrl then
         create poc_ctrl.

      assign
         sngl_ln = poc_ln_fmt
         pocmmts = poc_hcmmts.

      {pxrun.i &PROC='processRead' &PROGRAM='popoxr.p'
               &PARAM="(input ponbr,
                        buffer po_mstr,
                        input yes,
                        input yes)"
               &NOAPPERROR=true &CATCHERROR=true}

      if return-value = {&RECORD-NOT-FOUND} then do:

         clear frame vend.
/*GUI*/ RECT-FRAME-LABEL:SCREEN-VALUE in frame vend = F-vend-title.
         clear frame ship_to.
/*GUI*/ RECT-FRAME-LABEL:SCREEN-VALUE in frame ship_to = F-ship_to-title.
         clear frame b.
/*GUI*/ RECT-FRAME-LABEL:SCREEN-VALUE in frame b = F-b-title.

         /* ADDING NEW RECORD */
         {pxmsg.i &MSGNUM=1 &ERRORLEVEL=1}

         new_po = yes.

         {pxrun.i &PROC='createPurchaseOrder' &PROGRAM='popoxr.p'
                  &PARAM="(input ponbr,
                           buffer po_mstr)"
                  &NOAPPERROR=true &CATCHERROR=true}

         {pxrun.i &PROC='initializeBlanketPO' &PROGRAM='popoxr.p'
                  &PARAM="(input blanket,
                           buffer po_mstr)"
                  &NOAPPERROR=true &CATCHERROR=true}

      end.  /* IF NOT AVAILABLE PO_MSTR */

      else do:

         if po_stat = "C" then do:
            /* PURCHASE ORDER CLOSED */
            {pxmsg.i &MSGNUM=326 &ERRORLEVEL=1}
         end.
         if po_stat = "X" then do:
            /* PURCHASE ORDER CANCELLED */
            {pxmsg.i &MSGNUM=395 &ERRORLEVEL=1}
         end.

         {pxrun.i &PROC='validatePODataBase' &PROGRAM='popoxr1.p'
                  &PARAM="(input po_nbr)"
                  &NOAPPERROR=true &CATCHERROR=true}
         if return-value <> {&SUCCESS-RESULT} then do:
            undo mainloop, retry mainloop.
         end.

         new_po = no.
         /* MODIFYING EXISTING RECORD */
         {pxmsg.i &MSGNUM=10 &ERRORLEVEL=1}

         /* DISPLAY VENDOR ADDRESS */
         {mfaddisp.i po_vend vend}

         {pxrun.i &PROC='validateBlanketPO' &PROGRAM='popoxr.p'
                  &PARAM="(input po_type,
                           input blanket)"
                  &NOAPPERROR=true &CATCHERROR=true}
         if return-value <> {&SUCCESS-RESULT} then do:
            undo mainloop, retry mainloop.
         end.

         {mfaddisp.i po_ship ship_to}

         disc = po_disc_pct.

         {pxrun.i &PROC='validateScheduledOrder' &PROGRAM='popoxr.p'
                  &PARAM="(input po_sched,
                           input {&WARNING-RESULT})"
                  &NOAPPERROR=true &CATCHERROR=true}

         {pxrun.i &PROC='getFirstPOLine' &PROGRAM='popoxr1.p'
                  &PARAM="(input po_nbr,
                           buffer pod_det)"
                  &NOAPPERROR=true &CATCHERROR=true}

         if available pod_det then
            so_job = pod_so_job.

         {pxrun.i &PROC='validateSiteSecurity' &PROGRAM='icsixr.p'
                  &PARAM="(input po_site,
                           input '')"
                  &NOAPPERROR=true &CATCHERROR=true}

         if return-value <> {&SUCCESS-RESULT} then do:

            display
               po_nbr
               po_vend
               po_ship
            with frame a.

            display
               po_ord_date
               po_due_date
               po_buyer
               po_bill
               so_job
               po_contract
               po_contact
               po_rmks
               po_pr_list2
               po_pr_list
               disc
               po_site
               po_project
               po_confirm
               po_curr
               po_lang
               po_taxable
               po_taxc
               po_tax_date
               po_fix_pr
               po_consignment
               po_cr_terms
               po_crt_int
               po_user_id
               po_req_id
               pocmmts
            with frame b.

            pause.
            undo mainloop, retry.

         end.

      end.

      assign
         recno = recid(po_mstr).

      if po_cmtindx <> 0 then
         pocmmts = yes.

      display
         po_nbr
         po_vend
         po_ship
      with frame a.

      display
         po_ord_date
         po_due_date
         po_buyer
         po_bill
         so_job
         po_contract
         po_contact
         po_rmks
         po_pr_list2
         po_pr_list
         disc
         po_site
         po_project
         po_confirm
         po_curr
         po_lang
         po_taxable
         po_taxc
         po_tax_date
         po_fix_pr
         po_consignment
         po_cr_terms
         po_crt_int
         po_user_id
         po_req_id
         pocmmts
      with frame b.

      assign
         old_vend = po_vend
         old_ship = po_ship.

      vendblk:
      do on error undo, retry:
/*GUI*/ if global-beam-me-up then undo, leave.


         prompt-for po_mstr.po_vend with frame a
         editing:

            /* FIND NEXT/PREVIOUS  RECORD */
            {mfnp.i vd_mstr po_vend vd_addr po_vend vd_addr vd_addr}

            if recno <> ? then do:
               po_vend = vd_addr.
               display
                  po_vend
               with frame a.
               find ad_mstr where ad_addr = vd_addr  no-lock.
               {mfaddisp.i po_vend vend}
            end.
         end.

         /* DO NOT ALLOW MOD TO VENDOR IF ANY RECEIPTS */
         if (not new_po and po_vend <> old_vend) or
            (not new_po and po_vend entered)
         then do:
            {pxrun.i &PROC='validateSupplierReceipts' &PROGRAM='popoxr.p'
                     &PARAM="(input old_vend,
                              input po_nbr)"
                     &NOAPPERROR=true &CATCHERROR=true}
            if return-value <> {&SUCCESS-RESULT} then do:
               display old_vend @ po_vend with frame a.
               next-prompt po_vend.
               clear frame vend.
/*GUI*/ RECT-FRAME-LABEL:SCREEN-VALUE in frame vend = F-vend-title.
               undo, retry.
            end.
            else
               l_rebook_lines = yes.
         end.

         /* DISPLAY VENDOR ADDRESS */
         {mfaddisp.i "input po_vend" vend}

         if not new_po and input po_vend <> old_vend
         then do:
            {pxrun.i &PROC='validateScheduledOrder' &PROGRAM='popoxr.p'
                     &PARAM="(input po_sched,
                              input {&APP-ERROR-RESULT})"
                     &NOAPPERROR=true &CATCHERROR=true}
            if return-value <> {&SUCCESS-RESULT} then do:
               clear frame vend.
/*GUI*/ RECT-FRAME-LABEL:SCREEN-VALUE in frame vend = F-vend-title.
               display old_vend @ po_vend with frame a.
               undo, retry.
            end.
         end.

      end.
/*GUI*/ if global-beam-me-up then undo, leave.
 /* vendblk */

      {pxrun.i &PROC='validateSupplier' &PROGRAM='popoxr.p'
               &PARAM="(input po_vend:screen-value)"
               &NOAPPERROR=true &CATCHERROR=true}
      if return-value <> {&SUCCESS-RESULT} then do:
         next-prompt po_vend with frame a.
         undo, retry.
      end.

      if not available vd_mstr then do:
         /* USER ENTERED A SPECIFIC SUPPLIER NUMBER,         */
         /* WE NEED THE RECORD FOR THE RECID FUNCTION BELOW. */
         {pxrun.i &PROC='processRead' &PROGRAM='adsuxr.p'
                  &PARAM="(input po_vend:screen-value,
                           buffer vd_mstr,
                           input no,
                           input yes)"
                  &NOAPPERROR=true &CATCHERROR=true}
      end.

      if new_po then do:
         {pxrun.i &PROC='setSupplierDefaults' &PROGRAM='popoxr.p'
                  &PARAM="(input input po_vend,
                           buffer po_mstr)"}

         if po_cr_terms <> "" then do:
            {pxrun.i &PROC='getCreditTermsInterest' &PROGRAM='adcrxr.p'
                     &PARAM="(input po_cr_terms,
                              output po_crt_int)"}
         end.

         {pxrun.i &PROC='getTaxData' &PROGRAM='adadxr.p'
                  &PARAM="(input input po_vend,
                           output po_taxable,
                           output po_taxc,
                           output tax_in,
                           output dummyCharValue,   /* Tax Type */
                           output po_tax_usage,
                           output dummyCharValue)"}

         /* IF USING SUPPLIER CONSIGNMENT THEN INITIALIZE */
         /* CONSIGNMENT FIELDS.   */
         if using_supplier_consignment then do:
            {pxrun.i &PROC = 'initializeSuppConsignFields'
                     &PARAM="(input po_vend,
                              output po_consignment,
                              output po_max_aging_days)"}
            if return-value <> {&SUCCESS-RESULT}
               then do:
                  if return-value = "3388" then do:
                     {pxmsg.i &MSGNUM=return-value
                              &ERRORLEVEL=3
                              &MSGARG1=getTermLabel(""SUPPLIER_CONSIGNMENT"",30)}
                  end.
                  else do:
                     {pxmsg.i &MSGNUM=return-value &ERRORLEVEL=2}
                  end.
                  next-prompt po_vend with frame a.
                  undo, retry.
            end. /* if return-value <> */
            display po_consignment with frame b.
         end. /* IF using_supplier_consignment */
      end. /* If new_po */

      if (not new_po) and (old_vend <> input po_vend)
      then do:
         {pxrun.i &PROC='validateSupplierCurrency' &PROGRAM='popoxr.p'
                  &PARAM="(input po_curr,
                           input input po_vend)"
                  &NOAPPERROR=true &CATCHERROR=true}
         if return-value <> {&SUCCESS-RESULT} then do:
            next-prompt po_vend.
            undo, retry.
         end.
      end.

      assign
         po_vend = input po_vend
         vd_recno = recid(vd_mstr).

      do on error undo, retry:
/*GUI*/ if global-beam-me-up then undo, leave.


         prompt-for po_mstr.po_ship with frame a
         editing:
            /* FIND NEXT/PREVIOUS  RECORD */
            {mfnp.i ad_mstr po_ship ad_addr po_ship ad_addr ad_addr}
            if recno <> ? then do:
               po_ship = ad_addr.
               display po_ship with frame a.
               /* DISPLAY SHIP TO ADDRESS */
               {mfaddisp.i po_ship ship_to}
            end.
         end.

         {pxrun.i &PROC='validateShipTo' &PROGRAM='popoxr.p'
                  &PARAM="(input input po_ship)"
                  &NOAPPERROR=true &CATCHERROR=true}
         if return-value <> {&SUCCESS-RESULT} then do:
            undo, retry.
         end.

         assign
            po_ship = input po_ship.

         {mfaddisp.i po_ship ship_to}

      end.
/*GUI*/ if global-beam-me-up then undo, leave.


      /* SET GLOBAL REFERENCE VARIABLE FOR COMMENTS TO VENDOR */
      assign
         global_ref = po_vend
         po_recno   = recid(po_mstr)
         continue   = no
         del-yn     = no.

      /* PURCHASE ORDER MAINTENANCE -- ORDER HEADER subroutine */
/*cli      {gprun.i ""popomtb.p"" "(input using_supplier_consignment)"} */
/*cli*/ {gprun.i ""xxpomtb.p"" "(input using_supplier_consignment)"} 
/*GUI*/ if global-beam-me-up then undo, leave.


      if del-yn then
         next mainloop.
      if continue = no then
         undo mainloop, retry.

      if (oldcurr <> po_curr) or oldcurr = "" then do:
         /* SET CURRENCY DEPENDENT FORMATS */
         {pocurfmt.i}
         oldcurr = po_curr.
      end.

      {pxrun.i &PROC='getTaxDate' &PROGRAM='popoxr.p'
               &PARAM="(input po_tax_date,
                        input po_due_date,
                        input po_ord_date,
                        output tax_date)"
               &NOAPPERROR=true &CATCHERROR=true}

      if l_rebook_lines and
         not pBlanket
      then do:
         {gprun.i ""pomtrb.p"" "(input old_vend)"}
/*GUI*/ if global-beam-me-up then undo, leave.

         l_rebook_lines = no.
      end. /* IF L_REBOOK_LINES AND NOT BLANKET ORDER */

      /* FIND LAST LINE */
      line = 0.

      {pxrun.i &PROC='getLastPOLine' &PROGRAM='popoxr1.p'
               &PARAM="(input po_nbr,
                        output line)"
               &NOAPPERROR=true &CATCHERROR=true}

      po_recno = recid(po_mstr).

      /* IF BLANKET PO THEN BRING UP EXTRA SCREEN */
      if pBlanket then do:
         hide frame b no-pause.
         {gprun.i ""poblmt1.p""}
/*GUI*/ if global-beam-me-up then undo, leave.

      end.

           do:   
      hide frame a no-pause.
      hide frame vend no-pause.
      hide frame ship_to no-pause.
      hide frame b no-pause.
           end.   

      /*COMMENTS */
      assign
         global_type = ""
         global_lang = po_lang.

      if pocmmts = yes then do:

         assign
            global_ref = po_vend
            cmtindx = po_cmtindx.

         {gprun.i ""gpcmmt01.p"" "(input ""po_mstr"")"}
/*GUI*/ if global-beam-me-up then undo, leave.


         po_cmtindx = cmtindx.

      end.

   end.
/*GUI*/ if global-beam-me-up then undo, leave.


   due_date = po_due_date.

   /* LINE ITEMS */
   {gprun.i ""popomta.p""}
/*GUI*/ if global-beam-me-up then undo, leave.


   /* TRAILER */
   hide all.
   /*GUI: view frame dtitle. */
IF global-tool-bar AND global-tool-bar-handle ne ? THEN
  view global-tool-bar-handle. /*GUI*/

   view frame a.

   {gprun.i ""popomtf.p""}
/*GUI*/ if global-beam-me-up then undo, leave.


   {&POMT-P-TAG1}
   /* IMPORT EXPORT UPDATE */
   if not batchrun and impexp then do:
      {pxrun.i &PROC='import-export-update'}
   end. /*IF NOT BATCHRUN AND IMPEXP */
   if not impexp_edit then do:     /* CLEAN UP FRAMES DISPLAYED */
      hide all no-pause.
      /*GUI: view frame dtitle. */
IF global-tool-bar AND global-tool-bar-handle ne ? THEN
  view global-tool-bar-handle. /*GUI*/

   end.

   {pxrun.i &PROC='copyPOToOtherDBs' &PROGRAM='popoxr.p'
            &PARAM="(input po_nbr,
                     input false /* NOT BLANKET PO MAINT */ )"
            &NOAPPERROR=true &CATCHERROR=true}

   release po_mstr no-error.

end.
/*GUI*/ if global-beam-me-up then undo, leave.


status input.

/* ========================================================================== */
/* *************************** INTERNAL PROCEDURES ************************** */
/* ========================================================================== */

PROCEDURE get-input:
/*------------------------------------------------------------------------------
  Purpose:     Prompt for po_nbr.
  Notes:
  History:
------------------------------------------------------------------------------*/

   prompt-for po_nbr with frame a
   editing:

      /* Allow last PO number refresh */
      if keyfunction(lastkey) = "RECALL" or lastkey = 307
      then
         display ponbr @ po_nbr with frame a.

      /* FIND NEXT/PREVIOUS  RECORD */
      if blanket = false then do:
         /* Do not scroll thru RTS for PO or PO for RTS */
         {mfnp05.i
            po_mstr
            po_nbr
            "po_type <> ""B"" and po_fsm_type = """""
            po_nbr
            "input po_nbr"}
      end.
      else do:
         {mfnp01.i po_mstr po_nbr po_nbr po_type ""B"" po_type}
      end.

      if recno <> ? then do:

         disc = po_disc_pct.

         /* DISPLAY VENDOR ADDRESS */
         {mfaddisp.i po_vend vend}
         /* DISPLAY SHIP TO ADDRESS */
         {mfaddisp.i po_ship ship_to}

         display
            po_nbr
            po_vend
            po_ship
         with frame a.

         display
            po_ord_date
            po_due_date
            po_buyer
            po_bill
            so_job
            po_contract
            po_contact
            po_rmks
            po_pr_list2
            po_pr_list
            disc
            po_site
            po_project
            po_confirm
            po_curr
            po_lang
            po_taxable
            po_taxc
            po_tax_date
            po_fix_pr
            po_cr_terms
            po_crt_int
            po_user_id
            po_req_id
            pocmmts
            po_consignment
         with frame b.

      end.  /* IF RECNO <> ? */

   end. /* PROMPT-FOR...EDITING */

   find po_mstr where po_nbr = input po_nbr no-lock no-error.
   if available po_mstr then do:

      {pxrun.i &PROC='validateRTSOrder' &PROGRAM='popoxr.p'
               &PARAM="(input po_fsm_type)"
               &NOAPPERROR=true &CATCHERROR=true}

      if return-value <> {&SUCCESS-RESULT} then do:
         next-prompt po_nbr with frame a.
         undo, retry.
      end.

      {pxrun.i &PROC='validateEMTOrder' &PROGRAM='popoxr.p'
               &PARAM="(input po_is_btb)"
               &NOAPPERROR=true &CATCHERROR=true}

      if return-value <> {&SUCCESS-RESULT} then do:
         next-prompt po_nbr with frame a.
         undo, retry.
      end.

   end.

   if input po_nbr <> "" then
      ponbr = input po_nbr.

   do transaction on error undo,retry:
/*GUI*/ if global-beam-me-up then undo, leave.

      if input po_nbr = "" then do:

/*cli**  Begin ***** Generate a new Purchase Order Number from NRM *****/ 

         prompt-for po_site with frame c row 8 center overlay THREE-D .
         assign posite = input po_site.

         {gprun.i ""gpsiver.p""
         "(input posite, input ?, output return_int)"}
/*GUI*/  if global-beam-me-up then undo, leave.

         if return_int = 0 then do:
            /* User does not have access to default site # */
            {pxmsg.i &MSGNUM=2711 &ERRORLEVEL=2 &MSGARG1=posite}
            pause.
            undo, retry.
         end.
         find first nrs_mstr where nrs_site = input po_site and 
              nrs_ponbr <> "" no-lock no-error.
         if available nrs_mstr then do:  
             assign nrmnbr = nrs_ponbr.  
             if nrm-seq-num = " " then do:
               {gprunp.i "xxnrm" "p" "nr_dispense"
               "(input nrmnbr,
               input TODAY,
               output nrm-seq-num)"}
             end. /* IF nrm-seq-num = " " */
             if nrm-seq-num = "" then
         /* Get next Purchase Order Number with prefix */
         {pxrun.i &PROC='getNextPONumber' &PROGRAM='popoxr.p'
                  &PARAM="(output poNbr)"
                  &NOAPPERROR=true &CATCHERROR=true}
/*GUI*/  if global-beam-me-up then undo, leave.
         end.
         else 
             /* GET NEXT PURCHASE ORDER NUMBER WITH PREFIX */
         {pxrun.i &PROC='getNextPONumber' &PROGRAM='popoxr.p'
                  &PARAM="(output poNbr)"
                  &NOAPPERROR=true &CATCHERROR=true}
                  
/*GUI*/  if global-beam-me-up then undo, leave.

/*cli******* Generate a new Purchase Order Number from NRM ************/
/*cli
         {pxrun.i &PROC='getNextPONumber' &PROGRAM='popoxr.p'
                  &PARAM="(output poNbr)"
                  &NOAPPERROR=true &CATCHERROR=true}
*cli*/     
      end.
   end.
/*GUI*/ if global-beam-me-up then undo, leave.
 /* DO TRANSACTION ON ERROR UNDO.. */

   {gpbrparm.i &browse=dtlu001.p &parm=c-brparm1 &val=poNbr}
END PROCEDURE.

PROCEDURE import-export-update:
/*------------------------------------------------------------------------------
  Purpose:
  Notes:
  History:
------------------------------------------------------------------------------*/

   assign
      impexp_edit = no
      upd_okay = no.

   /* VIEW/EDIT IMPORT/EXPORT DATA ? */
   {pxmsg.i &MSGNUM=271 &ERRORLEVEL=1 &CONFIRM=impexp_edit}

   /* VIEW EDIT IMPORT EXPORT DATA ? */
   if impexp_edit then do:
      hide all.
      /*GUI: view frame dtitle. */
IF global-tool-bar AND global-tool-bar-handle ne ? THEN
  view global-tool-bar-handle. /*GUI*/

      view frame a.
      {gprun.i ""iedmta.p""
         "(input ""2"",
           input po_mstr.po_nbr,
           input-output upd_okay )" }
/*GUI*/ if global-beam-me-up then undo, leave.

   end.

END PROCEDURE.

PROCEDURE initialize-variables:
/*------------------------------------------------------------------------------
  Purpose:
  Notes:
  History:
------------------------------------------------------------------------------*/

   assign
      nontax_old         = nontaxable_amt:format in frame potot
      taxable_old        = taxable_amt:format
      lines_tot_old      = lines_total:format
      tax_tot_old        = tax_total:format
      order_amt_old      = order_amt:format
      prepaid_old        = po_prepaid:format in frame pomtd
      oldcurr = "".

   do transaction on error undo, retry:
      /* SET UP PRICING BY LINE VALUES */
      find first mfc_ctrl where mfc_field = "poc_pc_line"
      no-lock no-error.
      if available mfc_ctrl then
         poc_pc_line = mfc_logical.
   end.

END PROCEDURE.
